home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / lisp / info.jl < prev    next >
Lisp/Scheme  |  1995-03-09  |  19KB  |  563 lines
  1. ;;;; info.jl -- Info browser
  2. ;;;  Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (provide 'info)
  21.  
  22. ;;; Limitations:
  23. ;;; - Depends wholly on tag tables --- does no searching for nodes just looks
  24. ;;;   up their position (except in the dir file).
  25. ;;; - No support for `*' node name.
  26. ;;; - Doesn't work 100% with info files formatted by emacs. For best results
  27. ;;;   makeinfo has to be used.
  28. ;;; - No editing of nodes.
  29.  
  30. (defvar info-directory-list
  31.   (if (amiga-p) '("INFO:") '("/usr/info" "/usr/local/info/" "~/info"))
  32.   "List of directories to search for info files if they can't be found as-is.")
  33.  
  34. (defvar info-keymap (make-keytab)
  35.   "Keymap for Info.")
  36.  
  37. (defvar info-buffer (make-buffer "*Info*")
  38.   "Buffer in which Info nodes are displayed.")
  39. (set-buffer-special info-buffer t)
  40.  
  41. (defvar info-tags-buffer (make-buffer "*Info tags*")
  42.   "Buffer for storing the current Info file's tag table.")
  43. (set-buffer-special info-tags-buffer t)
  44.  
  45. (defvar info-history '()
  46.   "List of `(FILE NODE POS)' showing how we got to the current node.")
  47.  
  48. (defvar info-file-name nil
  49.   "The true name (in the filesystem) of the current Info file.")
  50.  
  51. (defvar info-node-name nil
  52.   "The name of the current Info node.")
  53.  
  54. (defvar info-file-modtime nil
  55.   "The modtime of file `info-file-name' last time we read something from it.")
  56.  
  57. (defvar info-indirect-list nil
  58.   "List of `(START-OFFSET . FILE-NAME)' saying where the current Info file
  59. is split.")
  60.  
  61. (defvar info-has-tags-p nil
  62.   "t when we were able to load a tag table for this Info file.")
  63.  
  64. (defvar info-initialised nil
  65.   "Protection against being loaded multiple times.")
  66.  
  67. (unless info-initialised
  68.   (setq info-initialised t)
  69.   (put 'info-error 'error-message "Info")
  70.   (bind-keys info-keymap
  71.     "SPC" 'next-screen
  72.     "BS" 'prev-screen
  73.     "1" 'info-menu-nth
  74.     "2" 'info-menu-nth
  75.     "3" 'info-menu-nth
  76.     "4" 'info-menu-nth
  77.     "5" 'info-menu-nth
  78.     "6" 'info-menu-nth
  79.     "7" 'info-menu-nth
  80.     "8" 'info-menu-nth
  81.     "9" 'info-menu-nth
  82.     "b" 'goto-buffer-start
  83.     "d" '(info "(dir)Top")
  84.     "f" 'info-follow-ref
  85.     "h" '(info "(info)Help")
  86.     "g" 'info-goto-node
  87.     "l" 'info-last
  88.     "m" 'info-menu
  89.     "n" 'info-next
  90.     "p" 'info-prev
  91.     "q" 'bury-buffer
  92.     "u" 'info-up
  93.     "?" 'describe-mode
  94.     "HELP" 'describe-mode
  95.     "RET" 'info-goto-link
  96.     "LMB-CLICK2" 'info-goto-link
  97.     "TAB" 'info-next-link
  98.     "Meta-TAB" 'info-prev-link
  99.     "Shift-TAB" 'info-prev-link)
  100.   (with-buffer info-buffer
  101.     (setq keymap-path (cons 'info-keymap keymap-path)
  102.       major-mode 'info-mode
  103.       buffer-record-undo nil)
  104.     (set-buffer-read-only info-buffer t))
  105.   (with-buffer info-tags-buffer
  106.     (setq buffer-record-undo nil)))
  107.  
  108. ;; Read the indirect list (if it exists) and tag table from the file FILENAME.
  109. ;; Indirect list ends up in `info-indirect-list', tag table is read into the
  110. ;; `info-tags-buffer' buffer. `info-has-tags-p' is set to t if a tags table
  111. ;; was loaded.
  112. (defun info-read-tags (filename)
  113.   (let
  114.       ((file (open filename "r"))
  115.        (dir (file-name-directory filename))
  116.        str)
  117.     (unless file
  118.       (signal 'info-error (list "Can't open info file" filename)))
  119.     (unwind-protect
  120.     (with-buffer info-tags-buffer
  121.       (clear-buffer)
  122.       (setq info-indirect-list nil
  123.         info-file-name nil
  124.         info-has-tags-p nil)
  125.       ;; Read until we find the tag table or the indirect list.
  126.       (setq str (read-file-until file "^(Tag Table:|Indirect:) *\n$" t))
  127.       (when (and str (regexp-match "Indirect" str t))
  128.         ;; Parse the indirect list
  129.         (while (and (setq str (read-line file))
  130.             (/= (aref str 0) ?\^_))
  131.           (setq info-indirect-list
  132.         (cons
  133.           (cons
  134.             (read-from-string (regexp-expand "^.*: ([0-9]+)\n$" str "\\1"))
  135.             (concat dir (regexp-expand "^(.*): [0-9]+\n$" str "\\1")))
  136.           info-indirect-list)))
  137.         (setq info-indirect-list (nreverse info-indirect-list))
  138.         ;; Now look for the tag table
  139.         (setq str (read-file-until file "^Tag Table: *\n$" t)))
  140.       (when (and str (regexp-match "Tag Table" str t))
  141.         (read-buffer file)
  142.         (setq info-has-tags-p t))
  143.       (setq info-file-name filename
  144.         info-file-modtime (file-modtime filename))
  145.       t)
  146.       (close file))))
  147.  
  148. ;; Read the `dir' file, if multiple `dir' files exist concatenate them
  149. (defun info-read-dir ()
  150.   (let
  151.       ((read-dir nil)
  152.        (path info-directory-list))
  153.     (clear-buffer)
  154.     (while path
  155.       (let
  156.       ((name (file-name-concat (expand-file-name (car path)) "dir")))
  157.     (when (file-exists-p name)
  158.       (if read-dir
  159.           (let
  160.           ((spos (cursor-pos)))
  161.         (insert (read-file name))
  162.         ;; lose all text from the beginning of the file to the
  163.         ;; first menu item
  164.         (when (find-next-regexp "^\\* Menu:" spos nil t)
  165.           (delete-area spos (next-line 1 (match-start)))))
  166.         (read-buffer name)
  167.         ;; try to delete the file's preamble
  168.         (when (find-next-regexp "^File:" (buffer-start) nil t)
  169.           (delete-area (buffer-start) (match-start)))
  170.         (goto-buffer-end)
  171.         (setq read-dir t))
  172.       (unless (equal (cursor-pos) (line-start))
  173.         (split-line))))
  174.       (setq path (cdr path)))
  175.     (unless read-dir
  176.       (signal 'info-error '("Can't find `dir' file")))
  177.     (setq info-file-name "dir"
  178.       info-file-modtime 0
  179.       info-node-name "Top"
  180.       mode-name "(dir)")
  181.     (goto-buffer-start)
  182.     t))
  183.  
  184. ;; Record the file, node and cursor-position in the `info-history' list
  185. ;; for the `info-last' command.
  186. (defun info-remember ()
  187.   (when (and info-file-name info-node-name)
  188.     (setq info-history (cons (list info-file-name
  189.                    info-node-name
  190.                    (cursor-pos))
  191.                  info-history))))
  192.  
  193. ;; Find the actual file for the info-file FILENAME
  194. (defun info-locate-file (filename)
  195.   (if (and info-file-name (or (not filename) (equal filename "")))
  196.       info-file-name
  197.     (let*
  198.     ((filename-and-info (concat filename ".info"))
  199.      (lcase-name (translate-string (copy-sequence filename)
  200.                        downcase-table))
  201.      (lcase-and-info (concat lcase-name ".info")))
  202.       (cond
  203.        ((file-exists-p filename)
  204.     filename)
  205.        ((file-exists-p filename-and-info)
  206.     filename-and-info)
  207.        ((file-exists-p lcase-name)
  208.     lcase-name)
  209.        ((file-exists-p lcase-and-info)
  210.     lcase-and-info)
  211.        (t
  212.     (catch 'foo
  213.       (let
  214.           ((dir info-directory-list)
  215.            real)
  216.         (while dir
  217.           (setq real (expand-file-name (car dir)))
  218.           (cond
  219.            ((file-exists-p (file-name-concat real filename))
  220.         (throw 'foo (file-name-concat real filename)))
  221.            ((file-exists-p (file-name-concat real filename-and-info))
  222.         (throw 'foo (file-name-concat real filename-and-info)))
  223.            ((file-exists-p (file-name-concat real lcase-name))
  224.         (throw 'foo (file-name-concat real lcase-name)))
  225.            ((file-exists-p (file-name-concat real lcase-and-info))
  226.         (throw 'foo (file-name-concat real lcase-and-info))))
  227.           (setq dir (cdr dir)))
  228.         (signal 'info-error (list "Can't find file" filename)))))))))
  229.  
  230. ;; Display the node NODENAME. NODENAME can contain a file name. If no node
  231. ;; is specified go to `Top' node.
  232. ;; This depends on some magic for locating the node text. It only works 100%
  233. ;; with `makeinfo' generated files.
  234. (defun info-find-node (nodename)
  235.   (let
  236.       ((filename (regexp-expand "^\\((.*)\\).*$" nodename "\\1"))
  237.        (inhibit-read-only t)
  238.        offset)
  239.     (when filename
  240.       (unless (setq nodename (regexp-expand "^\\(.*\\)(.+)$" nodename "\\1"))
  241.     (setq nodename "Top")))
  242.     (if (member filename '("dir" "DIR" "Dir"))
  243.     (info-read-dir)
  244.       (setq filename (info-locate-file filename))
  245.       (when (or (not (equal info-file-name filename))
  246.         (> (file-modtime filename) info-file-modtime))
  247.     (info-read-tags filename))
  248.       (if (not info-has-tags-p)
  249.       (progn
  250.         (clear-buffer)
  251.         (read-buffer info-file-name info-buffer)
  252.         (goto-buffer-start)
  253.         (setq info-node-name ""
  254.           mode-name (concat ?( (file-name-nondirectory info-file-name) ?))))
  255.     (let
  256.         ((regexp (concat "^Node: " (regexp-quote nodename) ?\^?))
  257.          subfile text)
  258.       (if (find-next-regexp regexp (buffer-start) info-tags-buffer t)
  259.           (progn
  260.         (setq offset (read (cons info-tags-buffer (match-end))))
  261.         (if (null info-indirect-list)
  262.             (setq offset (+ offset 2)
  263.               subfile info-file-name)
  264.           (catch 'info
  265.             (let
  266.             ((list info-indirect-list))
  267.               (while (cdr list)
  268.             (when (< offset (car (car (cdr list))))
  269.               (setq subfile (car list))
  270.               (throw 'info))
  271.             (setq list (cdr list)))
  272.               (setq subfile (car list))))
  273.           ;; Use some magic to calculate the physical position of the
  274.           ;; node. This seems to work?
  275.           (if (eq subfile (car info-indirect-list))
  276.               (setq offset (+ offset 2))
  277.             (setq offset (+ (- offset (car subfile))
  278.                     (car (car info-indirect-list)) 2)))
  279.           (setq subfile (cdr subfile)))
  280.         (if (setq text (read-file-from-to subfile offset ?\^_))
  281.             (progn
  282.               (clear-buffer)
  283.               (insert text)
  284.               (goto-buffer-start)
  285.               (setq info-node-name nodename
  286.                 mode-name (concat ?( (file-name-nondirectory info-file-name)
  287.                           ?) info-node-name)))
  288.           (signal 'info-error (list "Can't read from file" filename))))
  289.         (signal 'info-error (list "Can't find node" nodename))))))))
  290.  
  291. ;; Return a list of all node names matching START in the current tag table
  292. (defun info-list-nodes (start)
  293.   (let
  294.       ((regexp (concat "^Node: (" (regexp-quote start) ".*)\^?"))
  295.        (list ()))
  296.     (with-buffer info-tags-buffer
  297.       (goto-buffer-start)
  298.       (while (find-next-regexp regexp nil nil t)
  299.     (goto-char (match-end))
  300.     (setq list (cons (regexp-expand-line regexp "\\1" nil nil t) list))))
  301.     list))
  302.  
  303. ;; `prompt2' variant. LIST-FUN is a function to call the first time a list
  304. ;; of possible completions is required.
  305. (defun info-prompt (list-fun &optional title default start)
  306.   (unless title
  307.     (setq title "Select node"))
  308.   (when default
  309.     (setq title (concat title " (default: " default ")")))
  310.   (unless start
  311.     (setq start ""))
  312.   (let*
  313.       ((prompt-completion-function #'(lambda (w)
  314.                        (unless prompt-list
  315.                      (with-buffer info-buffer
  316.                        (setq prompt-list (funcall list-fun))))
  317.                        (prompt-complete-from-list w)))
  318.        (prompt-validate-function 'prompt-validate-from-list)
  319.        (prompt-word-regexps prompt-def-regexps)
  320.        (prompt-list '())
  321.        (res (prompt2 title start)))
  322.     (if (equal res "")
  323.     default
  324.       res)))
  325.  
  326. ;;;###autoload
  327. (defun info (&optional start-node)
  328.   "Start the Info viewer. If START-NODE is given it specifies the node to
  329. show, otherwise the current node is used (or `(dir)' if this is the first
  330. time that `info' has been called)."
  331.   (interactive)
  332.   (goto-buffer info-buffer)
  333.   (cond
  334.    (start-node
  335.     (info-remember)
  336.     (info-find-node start-node))
  337.    ((and info-file-name info-node-name)
  338.     (when (> (file-modtime info-file-name) info-file-modtime)
  339.       (info-find-node info-node-name)))
  340.    (t
  341.     (info-find-node "(dir)"))))
  342.  
  343. ;; The *Info* buffer has this function as its major-mode so that `Ctrl-h m'
  344. ;; displays some meaningful text
  345. (defun info-mode ()
  346.   "Info mode:\n
  347. This mode is used to browse through the Info tree of documentation, special
  348. commands are,\n
  349.   `SPC'        Next screen of text
  350.   `BS'        Previous screen
  351.   `b'        Move to the start of this node
  352.   `1' to `9'    Go to the Nth menu item in this node
  353.   `d'        Find the `(dir)' node -- the root of Info
  354.   `f'        Find the node of the next cross-reference in this node
  355.   `g NODE RET'    Go to the node called NODE
  356.   `h'        Display the Info tutorial, the node `(info)Help'
  357.   `l'        Backtrack one node
  358.   `m'        Choose a menu item from this node
  359.   `n'        Find the `next' node
  360.   `p'        Go to the `previous' node
  361.   `u'        Display the parent node of this one
  362.   `q'        Quit Info
  363.   `?', `HELP'    Display this command summary
  364.   `RET',
  365.   `LMB-CLICK2'    Go to the link (menu item or xref) on this line
  366.   `TAB'        Put the cursor on the next link in this node
  367.   `Meta-TAB'    Move to the previous link in this node")
  368.  
  369. ;; Prompt for the name of a node and find it.
  370. (defun info-goto-node (node)
  371.   (interactive "sGoto node: ")
  372.   (when node
  373.     (info-remember)
  374.     (info-find-node node)))
  375.  
  376. ;; Returns the node name of the menu item on the current line
  377. (defun info-parse-menu-line ()
  378.   (or (regexp-expand-line "^\\* (.+)::" "\\1")
  379.       (regexp-expand-line "^\\* .+:[\t ]*((\\([^ ]+\\)|)([^,.]+|))\\." "\\1")))
  380.  
  381. ;; Return a list of the names of all menu items. Starts searching from
  382. ;; the cursor position.
  383. (defun info-list-menu-items ()
  384.   (let
  385.       ((list ())
  386.        (opos (cursor-pos)))
  387.     (while (find-next-regexp "^\\* [a-zA-Z0-9]+.*:")
  388.       (goto-char (match-end))
  389.       (setq list (cons (regexp-expand-line "^\\* ([^:.]+)" "\\1") list)))
  390.     list))
  391.  
  392. ;; Position the cursor at the start of the menu.
  393. (defun info-goto-menu-start ()
  394.   (when (or (find-prev-regexp "^\\* Menu:" nil nil t)
  395.         (find-next-regexp "^\\* Menu:" nil nil t))
  396.     (goto-char (next-line 1 (match-start)))))
  397.  
  398. ;; Goto the ITEM-INDEX'th menu item.
  399. (defun info-menu-nth (item-index)
  400.   (interactive (list (- (strtoc (current-event-string)) ?0)))
  401.   (unless (info-goto-menu-start)
  402.     (signal 'info-error (list "Can't find menu")))
  403.   (while (and (> item-index 0) (find-next-regexp "^\\* .*:"))
  404.     (goto-char (match-end))
  405.     (setq item-index (1- item-index)))
  406.   (when (/= item-index 0)
  407.     (signal 'info-error (list "Can't find menu node")))
  408.   (goto-line-start)
  409.   (let
  410.       ((nodename (info-parse-menu-line)))
  411.     (if nodename
  412.     (progn
  413.       (info-remember)
  414.       (info-find-node nodename))
  415.       (signal 'info-error (list "Menu line malformed")))))
  416.  
  417. ;; Prompt for the name of a menu item (with a default) and find it's node.
  418. (defun info-menu ()
  419.   (interactive)
  420.   (let
  421.       ((menu-name (regexp-expand-line "^\\* ([^:.]+)" "\\1")))
  422.     (when (info-goto-menu-start)
  423.       (let
  424.       ((opos (cursor-pos)))
  425.     (setq menu-name (info-prompt 'info-list-menu-items
  426.                      "Menu item:" menu-name))
  427.     (goto-char opos)))
  428.     (when menu-name
  429.       (if (find-next-regexp (concat "^\\* " (regexp-quote menu-name) ?:))
  430.       (progn
  431.         (goto-char (match-start))
  432.         (let
  433.         ((node-name (info-parse-menu-line)))
  434.           (if node-name
  435.           (progn
  436.             (info-remember)
  437.             (info-find-node node-name))
  438.         (signal 'info-error (list "Menu line malformed")))))
  439.     (signal 'info-error (list "Can't find menu" menu-name))))))
  440.  
  441. ;; Retrace our steps one node.
  442. (defun info-last ()
  443.   (interactive)
  444.   (if info-history
  445.       (progn
  446.     (let
  447.         ((hist (car info-history)))
  448.       (setq info-history (cdr info-history))
  449.       (when (info-find-node (concat ?( (car hist) ?) (nth 1 hist)))
  450.         (goto-char (nth 2 hist))
  451.         t)))
  452.     (message "No more history")
  453.     (beep)))
  454.  
  455. (defun info-next ()
  456.   (interactive)
  457.   (info-find-link "Next"))
  458.  
  459. (defun info-prev ()
  460.   (interactive)
  461.   (info-find-link "Prev"))
  462.  
  463. (defun info-up ()
  464.   (interactive)
  465.   (info-find-link "Up"))
  466.  
  467. (defun info-find-link (link-type)
  468.   (let*
  469.       ((regexp (concat link-type ": ([^,]*)(,|[\t ]*$)"))
  470.        (new-node (regexp-expand-line regexp "\\1" (buffer-start) nil t)))
  471.     (if new-node
  472.     (progn
  473.       (info-remember)
  474.       (info-find-node new-node))
  475.       (message (concat "No " link-type " node"))
  476.       (beep))))
  477.  
  478. ;; Check this line for a menuitem of an xref, if one exists find its node
  479. (defun info-goto-link ()
  480.   (interactive)
  481.   (let
  482.       (node)
  483.     (unless (setq node (cdr (info-parse-ref)))
  484.       (goto-line-start)
  485.       (unless (setq node (info-parse-menu-line))
  486.     (signal 'info-error '("Nothing on this line to go to"))))
  487.     (info-remember)
  488.     (info-find-node node)))
  489.  
  490. ;; Move the cursor to the next menuitem or xref
  491. (defun info-next-link ()
  492.   (interactive)
  493.   (let
  494.       ((pos (find-next-regexp "(^\\* |\\*Note)" (next-char) nil t)))
  495.     (while (and pos (looking-at "\\* Menu:" pos nil t))
  496.       (setq pos (find-next-regexp "(^\\* |\\*Note)" (next-char 1 pos) nil t)))
  497.     (goto-char pos)))
  498.  
  499. ;; Move the cursor to the previous menuitem or xref
  500. (defun info-prev-link ()
  501.   (interactive)
  502.   (let
  503.       ((pos (find-prev-regexp "(^\\* |\\*Note)" (prev-char) nil t)))
  504.     (while (and pos (looking-at "\\* Menu:" pos nil t))
  505.       (setq pos (find-prev-regexp "(^\\* |\\*Note)" (prev-char 1 pos) nil t)))
  506.     (goto-char pos)))
  507.  
  508. ;; Parse the cross-reference under the cursor into a cons-cell containing
  509. ;; its title and node. This is fairly hairy since it has to cope with refs
  510. ;; crossing line boundarys.
  511. (defun info-parse-ref ()
  512.   (when (looking-at "\\*Note *" nil nil t)
  513.     (let
  514.     ((pos (match-end))
  515.      end ref-title ref-node)
  516.       (if (setq end (find-next-regexp "[\t ]*:"))
  517.       (progn
  518.         (while (> (pos-line end) (pos-line pos))
  519.           (let
  520.           ((bit (copy-area pos (find-next-regexp "[\t ]*$" pos))))
  521.         (unless (equal bit "")
  522.           (setq ref-title (cons ?\  (cons bit ref-title)))))
  523.           (setq pos (find-next-regexp "[^\t ]" (match-end)))
  524.           (unless pos
  525.         (signal 'info-error '("Malformed reference"))))
  526.         (setq ref-title (apply 'concat (nreverse (cons (copy-area pos end)
  527.                                ref-title)))
  528.           pos (next-char 1 end))
  529.         (if (= (get-char pos) ?:)
  530.         (setq ref-node ref-title)
  531.           (when (looking-at " +" pos)
  532.         (setq pos (match-end)))
  533.           (if (setq end (find-next-regexp "[\t ]*[:,.]" pos))
  534.           (progn
  535.             (while (> (pos-line end) (pos-line pos))
  536.               (let
  537.               ((bit (copy-area pos (find-next-regexp "[\t ]*$"
  538.                                  pos))))
  539.             (unless (equal bit "")
  540.               (setq ref-node (cons ?\  (cons bit ref-node))))
  541.             (setq pos (find-next-regexp "[^\t ]" (match-end))))
  542.               (unless pos
  543.             (signal 'info-error '("Malformed reference"))))
  544.             (setq ref-node (apply 'concat (nreverse (cons (copy-area
  545.                                    pos end)
  546.                                   ref-node)))))
  547.         (signal 'info-error '("Malformed reference")))))
  548.     (signal 'info-error '("Malformed reference")))
  549.       (when (and ref-title ref-node)
  550.     (cons ref-title ref-node)))))
  551.  
  552. ;; This should give you a prompt with all xrefs in the node to complete from,
  553. ;; currently it just finds the node of the next xref
  554. (defun info-follow-ref ()
  555.   (interactive)
  556.   (unless (looking-at "\\*Note" nil nil t)
  557.     (goto-char (find-next-regexp "\\*Note" nil nil t)))
  558.   (let
  559.       ((ref (info-parse-ref)))
  560.     (when ref
  561.       (info-remember)
  562.       (info-find-node (cdr ref)))))
  563.